home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / pagectrl / PAGECTL1.PAS next >
Encoding:
Pascal/Delphi Source File  |  1997-09-02  |  3.1 KB  |  124 lines
  1. unit PageCtl1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, CommCtrl, SysUtils, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TPageControlStyle = (pcsStandard, pcsOwnerDraw);
  11.  
  12.   TODPageControl = class(TPageControl)
  13.   private
  14.     FCanvas       : TCanvas;
  15.     FOnDrawItem   : TDrawItemEvent;
  16.     FStyle        : TPageControlStyle;
  17.     procedure DrawItem(Index: Integer; ARect: TRect;
  18.       State: TOwnerDrawState);
  19.   protected
  20.     procedure CreateParams(var Params: TCreateParams); override;
  21.     procedure SetStyle(Value: TPageControlStyle);
  22.     procedure CNDrawItem(var Msg: TWMDrawItem);
  23.       message cn_DrawItem;
  24.   public
  25.     constructor Create(AOwner: TComponent); override;
  26.     destructor Destroy; override;
  27.     procedure DefaultDrawTab(Index: Integer; ARect: TRect;
  28.       State: TOwnerDrawState); virtual;
  29.     property Canvas: TCanvas read FCanvas;
  30.   published
  31.     property Style: TPageControlStyle
  32.       read FStyle write SetStyle default pcsStandard;
  33.     property OnDrawItem: TDrawItemEvent
  34.       read FOnDrawItem write FOnDrawItem;
  35.   end;
  36.  
  37. procedure Register;
  38.  
  39. implementation
  40.  
  41. constructor TODPageControl.Create(AOwner: TComponent);
  42. begin
  43.   inherited;
  44.   FStyle := pcsStandard;
  45. end;
  46.  
  47. destructor TODPageControl.Destroy;
  48. begin
  49.   //Cleanup after ourselves
  50.   if Assigned(FCanvas) then
  51.     FCanvas.Free;
  52.   inherited
  53. end;
  54.  
  55. procedure TODPageControl.DrawItem(Index: Integer; ARect: TRect;
  56.   State: TOwnerDrawState);
  57. begin
  58.   if Assigned(FOnDrawItem) then
  59.     FOnDrawItem(Self, Index, ARect, State)
  60.   else
  61.     DefaultDrawTab(Index, ARect, State)
  62. end;
  63.  
  64. procedure TODPageControl.CreateParams(var Params: TCreateParams);
  65. const
  66.   OwnStyle: array[Boolean] of LongInt = (0, tcs_OwnerDrawFixed);
  67. begin
  68.   inherited;
  69.   with Params do
  70.     Style := Style or OwnStyle[FStyle = pcsOwnerDraw];
  71. end;
  72.  
  73. procedure TODPageControl.SetStyle(Value: TPageControlStyle);
  74. begin
  75.   if Value <> FStyle then
  76.   begin
  77.     FStyle := Value;
  78.     RecreateWnd;
  79.   end;
  80. end;
  81.  
  82. procedure TODPageControl.CNDrawItem(var Msg: TWMDrawItem);
  83. var
  84.   State: TOwnerDrawState;
  85. begin
  86.   if not Assigned(FCanvas) then
  87.     FCanvas := TCanvas.Create;
  88.   with Msg.DrawItemStruct^ do
  89.   begin
  90.     //The low byte of ItemState is the bitmap that our set requires
  91.     State := TOwnerDrawState(WordRec(Word(ItemState)).Lo);
  92.     FCanvas.Handle := hDC;
  93.     FCanvas.Font   := Font;
  94.     FCanvas.Brush  := Brush;
  95.     if Integer(itemID) >= 0 then
  96.       DrawItem(itemID, rcItem, State);
  97.     FCanvas.Handle := 0;
  98.   end;
  99. end;
  100.  
  101. procedure TODPageControl.DefaultDrawTab(Index: Integer;
  102.   ARect: TRect; State: TOwnerDrawState);
  103. var
  104.   S: String;
  105.   X, Y: Integer;
  106. begin
  107.   //Do a bit of default drawing when the
  108.   //component user is'nt doing it
  109.   FCanvas.FillRect(ARect);
  110.   S := Pages[Index].Caption;
  111.   X := (ARect.Right + ARect.Left - FCanvas.TextWidth(S)) div 2;
  112.   Y := (ARect.Bottom + ARect.Top + 4 - FCanvas.TextHeight(S)) div 2;
  113.   //Active tab has text _slightly_ higher
  114.   if odSelected in State then
  115.     Dec(Y, 3);
  116.   FCanvas.TextOut(X, Y, S);
  117. end;
  118.  
  119. procedure Register;
  120. begin
  121.   RegisterComponents('Clinic', [TODPageControl]);
  122. end;
  123.  
  124. end.